home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0050_Time & Date Stamp Generator.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  8KB  |  271 lines
  1. unit Dates;
  2.  
  3. {Gives time and date passed in DateTime format (defined by the DOS unit)
  4.  as a fully formatted string.  DFormat is a word type variable that tells
  5.  the code how to handle the time and date:
  6.  
  7.  
  8.  Bit  Function:             If 0:                 If 1:
  9.  ---  --------------------  --------------------  --------------------
  10.   15  ShowDOW               Don't show day name   Show day name
  11.   14  Century               Show year as XX       Show year as XXXX
  12.   13  SpaceDate             No spaces in date     Space between fields
  13.   12  CommaSep              Use comma in date     don't use comma
  14.   11  MonthType             Numerical             English name
  15.   10  > DateOrder | 00 -- DDMMYY | 10 -- YYMMDD
  16.    9  >           | 01 -- MMDDYY | 11 -- YYDDMM
  17.    8  MonthName             3 letters only        Full name of month
  18.    7  DateSep               Space date with " "   Space date with "-"
  19.    6  DTOrder               time then date        date then time
  20.    5  > TDSpace 00 - 11 : 1 - 4 spaces, respectively
  21.    4  >
  22.    3  HourPad               Use needed spaces     Always uses 2 spaces
  23.    2  HPadMeth              Pad hour with " "     Pad hour with "0"
  24.    1  MSPadMeth             Pad min/sec with " "  Pad min/sec with "0"
  25.    0  Show12_24             Use 12 hr. & am/pm    24-hour (military)
  26.  
  27.  Some fields require others to be set/clear to have any affect.  I never
  28.  got around to defining any constants for the fields, but that's easy
  29.  enough to take care of in the interface section, if needed.
  30.  
  31.  Use freely in any venture, private or public, but if you use it in anything
  32.  that makes money, please at the very least, let me the author of this unit,
  33.  know about it!  :-)
  34.  
  35.  Standard disclaimers apply.
  36.  
  37.  Written (and Submitted) by Scott Earnest, some time in 1994
  38.  e-mail (Internet): scott@whiplash.pc.cc.cmu.edu
  39. }
  40.  
  41. interface
  42.  
  43. uses DOS;
  44.  
  45. var
  46.   lastdate : string;
  47.  
  48. function DateTimeString (Chron : DateTime; DFormat : word) : string;
  49.  
  50. implementation
  51.  
  52. const
  53.   Month3 : array [1 .. 12] of string[3] =
  54.     ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  55.      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  56.   MonthF : array [1 .. 12] of string [6] =
  57.     ('uary',   'ruary',  'ch',     'il',     '',       'e',
  58.      'y',      'ust',    'tember', 'ober',   'ember',  'ember');
  59.   DayName : array [0 .. 6] of string[9] =
  60.     ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
  61.      'Thursday', 'Friday', 'Saturday');
  62.   PadSpace = ' ';
  63.   PadDash = '-';
  64.   PadZero = '0';
  65.  
  66. type
  67.   TDateTimeFormat = record
  68.                       ShowDOW,
  69.                       Century,
  70.                       SpaceDate,
  71.                       CommaSep,
  72.                       MonthType,
  73.                       MonthName,
  74.                       DateSep,
  75.                       DTOrder,
  76.                       HourPad,
  77.                       HPadMeth,
  78.                       MSPadMeth,
  79.                       Show12_24 : boolean;
  80.                       DateOrder,
  81.                       TDSpace : byte;
  82.                     end;
  83.  
  84. var
  85.   df : TDateTimeFormat;
  86.  
  87. procedure SetFlags_df (fvar : word);
  88.  
  89.   procedure shiftr;
  90.  
  91.   begin
  92.     fvar := fvar shr 1;
  93.   end;
  94.  
  95. begin
  96.   df.DateOrder := (fvar and $0600) shr 9;
  97.   df.TDSpace := (fvar and $0030) shr 4;
  98.   df.Show12_24 := odd (fvar); shiftr;
  99.   df.MSPadMeth := odd (fvar); shiftr;
  100.   df.HPadMeth := odd (fvar); shiftr;
  101.   df.HourPad := odd (fvar); shiftr;
  102.   shiftr; shiftr;
  103.   df.DTOrder := odd (fvar); shiftr;
  104.   df.DateSep := odd (fvar); shiftr;
  105.   df.MonthName := odd (fvar); shiftr;
  106.   shiftr; shiftr;
  107.   df.MonthType := odd (fvar); shiftr;
  108.   df.CommaSep := odd (fvar); shiftr;
  109.   df.SpaceDate := odd (fvar); shiftr;
  110.   df.Century := odd (fvar); shiftr;
  111.   df.ShowDow := odd (fvar); shiftr;
  112. end;
  113.  
  114. function CalcDOW (d, m, y : word) : byte;
  115.  
  116. var
  117.   t1, t2, t3, t4, t5, t6, t7 : integer;
  118.  
  119. begin
  120.   t1 := m + 12 * trunc (0.6 + 1 / m);
  121.   t2 := y - trunc (0.6 + 1 / m);
  122.   t3 := trunc (13 * (t1 + 1) / 5);
  123.   t4 := trunc (5 * t2 / 4);
  124.   t5 := trunc (t2 / 100);
  125.   t6 := trunc (t2 / 400);
  126.   t7 := t3 + t4 - t5 + t6 + d - 1;
  127.   CalcDOW := t7 - 7 * trunc (t7 / 7);
  128. end;
  129.  
  130. function PadNum (num : word; padch : char; places : byte) : string;
  131.  
  132. var
  133.   holdstr,
  134.   padstr : string;
  135.  
  136. begin
  137.   fillchar (padstr, sizeof(padstr), padch);
  138.   padstr[0] := #16;
  139.   str (num, holdstr);
  140.   padstr := concat (padstr, holdstr);
  141.   delete (padstr, 1, length (padstr) - places);
  142.   PadNum := padstr;
  143. end;
  144.  
  145. procedure BuildTime (var dt : DateTime; var ts : string);
  146.  
  147. var
  148.   pad : char;
  149.   tempstr : string;
  150.   hour : byte;
  151.  
  152. begin
  153.   case df.MSPadMeth of
  154.     true  : pad := PadZero;
  155.     false : pad := PadSpace;
  156.   end;
  157.   ts := concat (':', PadNum (dt.min, pad, 2), ':', PadNum (dt.sec, pad, 2));
  158.   case df.Show12_24 of
  159.     true  : hour := dt.hour;
  160.     false : begin
  161.               hour := dt.hour mod 12;
  162.               if hour = 0 then hour := 12;
  163.               case dt.hour of
  164.                 0 .. 11  : ts := concat (ts, 'a');
  165.                 12 .. 23 : ts := concat (ts, 'p');
  166.               end;
  167.             end;
  168.   end;
  169.   case df.HourPad of
  170.     true  : begin
  171.               case df.HPadMeth of
  172.                 true  : pad := PadZero;
  173.                 false : pad := PadSpace;
  174.               end;
  175.               ts := concat (PadNum (hour, pad, 2), ts);
  176.             end;
  177.     false : begin
  178.               str (hour, tempstr);
  179.               ts := concat (tempstr, ts);
  180.             end;
  181.   end;
  182. end;
  183.  
  184. procedure BuildDate (var dt : DateTime; var ds : string);
  185.  
  186. var
  187.   DOW : byte;
  188.   tempstr : string;
  189.   pad : string[1];
  190.   ystr, dstr : string[4];
  191.   mstr : string[9];
  192.  
  193. begin
  194.   if df.ShowDOW then
  195.     DOW := CalcDOW (dt.day, dt.month, dt.year);
  196.   ystr := PadNum (dt.year, ' ', (byte(df.Century) + 1) * 2);
  197.   case df.MonthType of
  198.     false : case df.SpaceDate of
  199.               false : mstr := PadNum (dt.month, '0', 2);
  200.               true  : str (dt.month, mstr);
  201.             end;
  202.     true  : begin
  203.               mstr := Month3[dt.month];
  204.               if df.MonthName then
  205.                 mstr := concat (mstr, MonthF[dt.month]);
  206.             end;
  207.   end;
  208.   case df.SpaceDate of
  209.     false : dstr := PadNum (dt.day, '0', 2);
  210.     true  : str (dt.day, dstr);
  211.   end;
  212.   case df.SpaceDate of
  213.     false : begin
  214.               case df.DateOrder of
  215.                 0 : ds := concat (dstr, mstr, ystr);
  216.                 1 : ds := concat (mstr, dstr, ystr);
  217.                 2 : ds := concat (ystr, mstr, dstr);
  218.                 3 : ds := concat (ystr, dstr, mstr);
  219.               end;
  220.             end;
  221.     true  : begin
  222.               case df.DateSep of
  223.                 false : pad := PadSpace;
  224.                 true  : pad := PadDash;
  225.               end;
  226.               case df.DateOrder of
  227.                 0 : ds := concat (dstr, pad, mstr, pad, ystr);
  228.                 1 : case df.CommaSep of
  229.                       false : ds := concat (mstr, pad, dstr, pad, ystr);
  230.                       true  : ds := concat (mstr, pad, dstr, ',', pad, ystr);
  231.                     end;
  232.                 2 : ds := concat (ystr, pad, mstr, pad, dstr);
  233.                 3 : ds := concat (ystr, pad, dstr, pad, mstr);
  234.               end;
  235.             end;
  236.   end;
  237.   if df.ShowDOW then
  238.     ds := concat (DayName[DOW], ' ', ds);
  239. end;
  240.  
  241. function spaces (ns : byte) : string;
  242.  
  243. var
  244.   holdstr : string;
  245.  
  246. begin
  247.   fillchar (holdstr, sizeof(holdstr), 32);
  248.   holdstr[0] := chr(ns);
  249.   spaces := holdstr;
  250. end;
  251.  
  252. function DateTimeString (Chron : DateTime; DFormat : word) : string;
  253.  
  254. var
  255.   dstr, tstr : string;
  256.  
  257. begin
  258.   dstr := ''; tstr := '';
  259.   SetFlags_df (DFormat);
  260.   BuildTime (Chron, tstr);
  261.   BuildDate (Chron, dstr);
  262.   case df.DTOrder of
  263.     false : DateTimeString := concat (tstr, spaces(df.TDSpace + 1), dstr);
  264.     true  : DateTimeString := concat (dstr, spaces(df.TDSpace + 1), tstr);
  265.   end;
  266. end;
  267.  
  268. begin
  269.   lastdate := '';
  270. end.
  271.